This document contains various maps showing adoption data from the Cincinnati Animal CARE shelter built to help plan for their participation in the Competitive Pet Placement project. Update 1/11: maps showing donor data were added.
The adoption data visualized here was obtained and processed as follows:
A CAC outcomes report filtered to include only Adoption outcomes from 2020-07-01 through 2023-09-30 served as the raw data.
Some additional cleaning was done, primarily removing apartment numbers from the street address column by removing all characters appearing after a comma.
The file was then geocoded using the Census Geocoder, which also provides a Census Tract for each geocoded address. 12189 (95%) out of the 12757 adoption records were geocoded successfully. The rest (which were spread across all years of data) were excluded from the analysis.
To narrow down the mapping, only addresses from OH (10471), KY (1376), and IN (253) were included, excluding 89 addresses from outside these states. The final dataset contains 12,100 geocoded adoption outcomes.
Census data for all tracts in which adoption outcomes occurred were retrieved from the Census API based on the received guidance - other variables can be added easily.
Maps focus on dogs based on our understanding of the area of most potential.
Donors data was processed in the same way. Out of 12300 donation records in the file received, 9814 had associated addresses. Out of those, 9320 (95%) were successfully geocoded and presented in the maps below. 99 donations for an amount of zero dollars were also removed.
This first map shows all adoptions in the data (Total) as well as adoptions per 1000 households, to account for the fact that places with more households are expected to have more adoptions. Note that there are a few area with many adoptions and unusually low household count in the census data so don’t focus on the specific numbers there too much but on the overall pattern.
# create total adoption
sf_all <-
dfmap %>%
filter(Species=='Dog') %>%
count(GEOID) %>%
left_join(census_df %>% select(GEOID, geometry), by='GEOID') %>% st_as_sf()
# create color palette
pal_all <- colorBin(palette='Purples', domain = sf_all$n, bins = c(0, 20, 40, 80, 160))
# create tooltip label
label_all <- sprintf("Tract %s<br/><strong>%g %s</strong>",
str_sub(sf_all$GEOID,-6,-1), sf_all$n, 'Adoptions') %>% lapply(htmltools::HTML)
# create per households df
sf_percap <-
dfmap %>%
filter(Species=='Dog') %>%
count(GEOID) %>%
left_join(census_df %>% select(GEOID, pop, households, geometry), by='GEOID') %>%
filter(households!=0) %>% # 13 geoids
mutate(per=round(n/households*1000)) %>%
st_as_sf()
# color palette and label - need to adjust for some really high # bc low household count
pal_percap <- colorBin(palette='Purples', domain = sf_percap$per, bins = c(0, 10, 25, 50, 100, 500, 1000))
label_percap <- sprintf("Tract %s<br/><strong>%g %s</strong>", str_sub(sf_percap$GEOID,-6,-1),
sf_percap$per, 'Adoptions per<br/>1000 households') %>% lapply(htmltools::HTML)
# all adoptions map
leaflet() %>%
addTiles() %>%
setView(lat = shelter_lat, lng = shelter_lng, zoom=10) %>% # CAC location
addMarkers(lat = shelter_lat, lng = shelter_lng, label='Cincinnati Animal CARE') %>%
addPolygons(data=fix_sf(sf_all), group='Total', fillColor=~pal_all(n),
fillOpacity = 0.8, color='grey', weight = 1, opacity = 0.4, label = label_all,
highlightOptions = highlightOptions(color = "black",weight = 2, bringToFront = TRUE)) %>%
addPolygons(data=fix_sf(sf_percap), group='Household', fillColor=~pal_percap(per),
fillOpacity = 0.8, color='grey', weight = 1, opacity = 0.4, label = label_percap,
highlightOptions = highlightOptions(color = "black",weight = 2, bringToFront = TRUE)) %>%
addLegend(pal = pal_all, values = sf_all$n, opacity = 0.8, title = 'Total Adoptions',
position = "bottomright", group='Total') %>%
addLegend(pal = pal_percap, values = sf_percap$per, opacity = 0.8, title = 'Adoptions per<br>1000 Households',
position = "bottomleft", group='Household') %>%
addLayersControl(
baseGroups = c('Total','Household'),
options = layersControlOptions(collapsed = FALSE)
) %>%
hideGroup(c('Household'))
Each layer shows a heatmap of adoptions that took place in a particular year.
This map shows all dog and cat adoptions for comparison.
Each layer shows a heatmap of adoptions of dogs of each size category. Extra Large animals were merged into Large.